unit uSBDUnit_controller1;
interface
uses uSBDUnit_Controller, uSBDUnit_Model, Classes, uSBDUnit_Types, Windows,
     Messages, ExtCtrls;

type
TSample1Controller = class( TInterfacedObject, IUnitTestController,
                            IControllerFeedback, IMainThreadedWindowedClient)
  private
    FModel: ITestEngine;
    FMessageHandler: TMessageHandler;
    FMessageNum: cardinal;
    FTimer: TTimer;
    FTimerEndHandler: TNotifyEvent;
    FCoObject: TObject;
    FisCounted: boolean;
    FRequestAbort: boolean;

    function  Can_ShutDown: boolean;
    procedure ShutDown;
    procedure SetModel( const Value: ITestEngine);
    procedure SetCoDestroyObject( Obj: TObject);
    procedure Run;
    function  Can_Run: boolean;

    procedure OnTimerMaturation( Sender: TObject);
    function  MainWindowHandle: HWND;
    procedure GetUnitTestMessageNum( var MessageNum: cardinal);
    procedure SetUnitTestHandler  ( UnitTest: TMessageHandler; MessageNum: cardinal; Cookie: TObject); // Hook message WM_UnitTest
    procedure ClearUnitTestHandler( Cookie: TObject);
    procedure SetTimer( OnMaturation: TNotifyEvent; Period_ms: integer; Cookie: TObject);
    procedure ClearTimer( Cookie: TObject);
    procedure Breathe;
    function  WndProc( var Message: TMessage): boolean;
    procedure Abort;
    function  Can_Abort: boolean;
    procedure Clear;
    function  Can_Clear: boolean;
    procedure DeselectAll;
    function  Can_DeselectAll: boolean;
    procedure SelectAll;
    function  Can_SelectAll: boolean;
    procedure SelectFailures;
    function  Can_SelectFailures: boolean;
    procedure ToggleSelection;
    function  Can_ToggleSelection: boolean;
    function  DoUserAbort: boolean;
    procedure SelectChildLeaves( const Parent: ITestNode; Select: boolean);
    procedure ToggleChildLeaves( const Parent: ITestNode);
    procedure SelectFailedChildLeaves( const Parent: ITestNode);

  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation





uses Forms, SysUtils, umfmGUIRunner;


{ TSample1Controller }

procedure TSample1Controller.Abort;
begin
FRequestAbort := True
end;

procedure TSample1Controller.Breathe;
begin
Application.ProcessMessages
end;

function TSample1Controller.Can_Abort: boolean;
begin
result := (not FRequestAbort) and FModel.Can_Abort
end;

function TSample1Controller.Can_Clear: boolean;
begin
result := FModel.Can_Clear
end;

function TSample1Controller.Can_DeselectAll: boolean;
begin
result := not FModel.isRunning
end;

function TSample1Controller.Can_Run: boolean;
begin
result := FModel.Can_Run
end;

function TSample1Controller.Can_SelectAll: boolean;
begin
result := not FModel.isRunning
end;

function TSample1Controller.Can_SelectFailures: boolean;
begin
result := not FModel.isRunning
end;

function TSample1Controller.Can_ShutDown: boolean;
begin
result := FModel.Can_ShutDown
end;

function TSample1Controller.Can_ToggleSelection: boolean;
begin
result := not FModel.isRunning
end;

procedure TSample1Controller.Clear;
begin
mfmGUIRunner.memoLog.Clear;
FModel.Clear
end;

procedure TSample1Controller.ClearTimer( Cookie: TObject);
begin
FreeAndNil( FTimer)
end;

procedure TSample1Controller.ClearUnitTestHandler(Cookie: TObject);
begin
FMessageNum      := 0;
FMessageHandler  := nil;
FTimerEndHandler := nil;
end;

constructor TSample1Controller.Create;
begin
_AddRef;
FisCounted := (_AddRef + _Release) <> -2;
FRequestAbort := False
end;

destructor TSample1Controller.Destroy;
begin
FCoObject.Free;
inherited
end;

function TSample1Controller.DoUserAbort: boolean;
begin
result := FRequestAbort
end;

procedure TSample1Controller.GetUnitTestMessageNum(var MessageNum: cardinal);
begin
end;

function TSample1Controller.MainWindowHandle: HWND;
begin
result := Application.MainForm.Handle
end;

procedure TSample1Controller.Run;
begin
FRequestAbort := False;
FModel.Run
end;

procedure TSample1Controller.SetCoDestroyObject( Obj: TObject);
begin
FCoObject := Obj
end;

procedure TSample1Controller.SetModel( const Value: ITestEngine);
begin
FModel := Value
end;

procedure TSample1Controller.SetTimer(
  OnMaturation: TNotifyEvent; Period_ms: integer; Cookie: TObject);
begin
FreeAndNil( FTimer);
FTimer := TTimer.Create( Application.MainForm);
FTimer.Interval  := Period_ms;
FTimerEndHandler := OnMaturation;
FTimer.OnTimer   := OnTimerMaturation;
FTimer.Enabled   := True
end;


procedure TSample1Controller.OnTimerMaturation( Sender: TObject);
var
  Local: TNotifyEvent;
begin
Local := FTimerEndHandler;
FTimer.Enabled := False;
FTimerEndHandler := nil;
if assigned( Local) then
  Local( Sender)
end;

procedure TSample1Controller.SetUnitTestHandler(
  UnitTest: TMessageHandler; MessageNum: cardinal; Cookie: TObject);
begin
FMessageNum     := MessageNum;
FMessageHandler := UnitTest
end;

procedure TSample1Controller.ShutDown;
begin
if assigned( FModel) then
  FModel.ShutDown;
FModel := nil;
if FisCounted then
    _Release
  else
    Destroy
end;

function TSample1Controller.WndProc( var Message: TMessage): boolean;
begin
result := (FMessageNum <> 0) and (FMessageNum = Message.Msg);
if result then
  FMessageHandler( Message)
end;

procedure TSample1Controller.SelectChildLeaves( const Parent: ITestNode; Select: boolean);
var
  j: integer;
  Child: ITestNode;
begin
for j := 0 to Parent.Count - 1 do
  begin
  Child := Parent.Children[j];
  if Child.Kind = nkTestCase then
    Child.Enabled := Select;
  SelectChildLeaves( Child, Select)
  end
end;

procedure TSample1Controller.DeselectAll;
begin
SelectChildLeaves( FModel.Root, False)
end;

procedure TSample1Controller.SelectAll;
begin
SelectChildLeaves( FModel.Root, True)
end;

procedure TSample1Controller.SelectFailedChildLeaves( const Parent: ITestNode);
var
  j: integer;
  Child: ITestNode;
begin
for j := 0 to Parent.Count - 1 do
  begin
  Child := Parent.Children[j];
  if Child.Kind = nkTestCase then
    Child.Enabled := Child.ExecutionResult = erFail;
  SelectFailedChildLeaves( Child)
  end
end;

procedure TSample1Controller.SelectFailures;
begin
SelectFailedChildLeaves( FModel.Root)
end;

procedure TSample1Controller.ToggleChildLeaves( const Parent: ITestNode);
var
  j: integer;
  Child: ITestNode;
begin
for j := 0 to Parent.Count - 1 do
  begin
  Child := Parent.Children[j];
  if Child.Kind = nkTestCase then
    Child.Enabled := not Child.Enabled;
  ToggleChildLeaves( Child)
  end
end;

procedure TSample1Controller.ToggleSelection;
begin
ToggleChildLeaves( FModel.Root)
end;


end.
